home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbinst13 / vbinst.bas < prev    next >
BASIC Source File  |  1992-09-01  |  2KB  |  63 lines
  1.  
  2. Sub FileCopy (Source$, Dest$)
  3. Screen.MousePointer = 11 'hourglass
  4. Open Source$ For Binary As #1
  5. whole = LOF(1) \ 32000        'numer of whole 32768 byte chunks
  6. part = LOF(1) Mod 32000     'remaining bytes at end of file
  7. buffer$ = String$(32000, 0)
  8. start& = 1
  9. Open Dest$ For Binary As #2
  10. For x = 1 To whole                   'this for-next loop will copy 32,000
  11.        Get #1, start&, buffer$       'byte chunks at a time. If there is
  12.        Put #2, start&, buffer$       'less than 32,000 bytes in the file,
  13.        start& = start& + 32000       'whole = 0  and the loop is bypassed.
  14. Next x
  15. buffer$ = String$(part, 0)           'this part of the routine will copy
  16. Get #1, start&, buffer$              'the remaining bytes at the end of the
  17. Put #2, start&, buffer$              'file.
  18. Close
  19.  
  20. End Sub
  21.  
  22. Sub IniCopy (lpApplication As String, lpKeyName As String, lpDefault As String, SubDir As String)
  23.  
  24.     'start loop
  25.     I = 0
  26.     Do
  27.         Screen.MousePointer = 11 'hourglass
  28.         State% = DoEvents() 'allows list files to copied to be updated
  29.         I = I + 1
  30.         lpKeyName$ = "file" + Str$(I)
  31.         GetStringvar% = GetPrivateProfileString(lpApplication$, lpKeyName$, lpDefault$, FileStr$, nSize%, lpFileName$)
  32.         'check named mark to end loop
  33.         If Left$(FileStr$, 7) = "EndMark" Then
  34.             Exit Do
  35.         ElseIf Left$(FileStr$, 8) = "EndMark" Then
  36.             Exit Do
  37.         End If
  38.         
  39.         'copy all program files to destination dir
  40.         File$ = RTrim$(FileStr$)            'move spaces from right
  41.         Dest$ = SubDir$ + "\" + File$
  42.         Source$ = SD$ + File$
  43.         
  44.         IsFile$ = Dir$(Dest$)      'check if file already exist
  45.         If IsFile$ = "" Then
  46.             Install.Lbl_List.Caption = "Now copying file " + FileStr$
  47.             FileCopy Source$, Dest$
  48.             Install.List1.AddItem Dest$
  49.         Else
  50.             Screen.MousePointer = 0
  51.             If WarnFlag = True Then   'check overwrite flag
  52.                 Warn.Lbl_Warn.Caption = "File already exist!, would you like to overwrite it? " + Dest$  'give the user a change to prevent overwriting
  53.                 Warn.Show 1
  54.             Else
  55.                 Install.Lbl_List.Caption = "Now copying file " + FileStr$
  56.                 Install.List1.AddItem Dest$
  57.             End If
  58.         End If
  59.     Loop
  60. Screen.MousePointer = 0 'default
  61. End Sub
  62.  
  63.